StopData_Maps

Read in the Data:

finaldf <- readRDS( 'StopData_finaldf.rds' )
mergedf <- readRDS( 'StopData_merged.rds' )

Create some maps

LOCATION INFO:

# Get longitude and latitude information for use with MAPs:
latmax <- max( finaldf$lat, na.rm = TRUE ) 
latmin <- min( finaldf$lat, na.rm = TRUE )
lonmax <- max( finaldf$long, na.rm = TRUE ) 
lonmin <- min( finaldf$long, na.rm = TRUE )
latvals <- c( latmin, latmax )
lonvals <- c( lonmin, lonmax )

MAP 1:

newmap <- getMap( resolution="low" )
plot( newmap, xlim = lonvals, ylim = latvals, asp=1 )
points( finaldf$long, finaldf$lat, col="red", cex=.6 )

MAP 2:

berkMap = map = get_map(location = c( lon = mean(lonvals), lat = mean(latvals) ), zoom = 13)

## Warning in download.file(url, destfile = tmp, quiet = !messaging, mode =
## "wb"): downloaded length 627710 != reported length 627710

## Map from URL : http://maps.googleapis.com/maps/api/staticmap?center=37.865887,-122.276384&zoom=13&size=640x640&scale=2&maptype=terrain&language=en-EN&sensor=false

ggmap(berkMap) +
  geom_point(aes(x = long, y = lat, colour = Incident.Type.Class), data = finaldf, alpha = 0.7) + 
  scale_colour_discrete( "Incident Type", labels = c("Pedestrian Stop", "Bicycle Stop", "Suspicious Vehicle Stop",  "Traffic Stop" ) ) +
  theme ( 
        #legend.position = c(0.05, 0.05), # put the legend INSIDE the plot area
        #legend.justification = c(0, 0),
        #legend.background = element_rect(colour = F, fill = "white"),
        #legend.key = element_rect (fill = F, colour = F),
        panel.grid.major = element_blank (), # remove major grid
        panel.grid.minor = element_blank (),  # remove minor grid
        axis.text = element_blank (), 
        axis.title = element_blank (),
        axis.ticks = element_blank ()
        ) + 
  ggtitle("BPD Stops 2015-2016") 

MAP 3:

ggmap(berkMap) +
  geom_point(aes(x = long, y = lat, colour = factor(Gender)), data = mergedf, alpha = 0.7) + 
  scale_colour_discrete( "Gender", labels = c("Female", "Male") ) +
  theme ( 
        panel.grid.major = element_blank (), # remove major grid
        panel.grid.minor = element_blank (),  # remove minor grid
        axis.text = element_blank (), 
        axis.title = element_blank (),
        axis.ticks = element_blank ()
        ) + 
  ggtitle("BPD Stops 2015-2016") 

MAP 4:

ggmap(berkMap) +
  geom_point(aes(x = long, y = lat, colour = factor(Race)), data = mergedf, alpha = 0.7, size = 3) + 
  scale_colour_discrete( "Race", labels = c("Asian", "Black", "Hispanic", "Other", "White")  ) +
  theme ( 
        panel.grid.major = element_blank (), # remove major grid
        panel.grid.minor = element_blank (),  # remove minor grid
        axis.text = element_blank (), 
        axis.title = element_blank (),
        axis.ticks = element_blank ()
        ) + ggtitle("BPD Stops 2015-2016")

MAP 5:

# doing it with qmplot is even easier
qmplot(long, lat, data = mergedf, maptype = "toner-lite",
  color = factor(Race), size = factor(CarSearch), legend = "topleft"
) + geom_point(alpha = .1)

## Using zoom = 13...

## Warning in download.file(url, destfile = tmp, quiet = !messaging, mode =
## "wb"): downloaded length 30610 != reported length 30610

## Map from URL : http://tile.stamen.com/toner-lite/13/1312/3162.png

## Map from URL : http://tile.stamen.com/toner-lite/13/1313/3162.png

## Warning in download.file(url, destfile = tmp, quiet = !messaging, mode =
## "wb"): downloaded length 16163 != reported length 16163

## Map from URL : http://tile.stamen.com/toner-lite/13/1314/3162.png

## Map from URL : http://tile.stamen.com/toner-lite/13/1312/3163.png

## Map from URL : http://tile.stamen.com/toner-lite/13/1313/3163.png

## Warning in download.file(url, destfile = tmp, quiet = !messaging, mode =
## "wb"): downloaded length 22893 != reported length 22893

## Map from URL : http://tile.stamen.com/toner-lite/13/1314/3163.png

## Warning in download.file(url, destfile = tmp, quiet = !messaging, mode =
## "wb"): downloaded length 6515 != reported length 6515

## Map from URL : http://tile.stamen.com/toner-lite/13/1312/3164.png

## Warning in download.file(url, destfile = tmp, quiet = !messaging, mode =
## "wb"): downloaded length 40350 != reported length 40350

## Map from URL : http://tile.stamen.com/toner-lite/13/1313/3164.png

## Warning in download.file(url, destfile = tmp, quiet = !messaging, mode =
## "wb"): downloaded length 35104 != reported length 35104

## Map from URL : http://tile.stamen.com/toner-lite/13/1314/3164.png

## Warning in download.file(url, destfile = tmp, quiet = !messaging, mode =
## "wb"): downloaded length 15639 != reported length 15639

## Map from URL : http://tile.stamen.com/toner-lite/13/1312/3165.png

## Warning in download.file(url, destfile = tmp, quiet = !messaging, mode =
## "wb"): downloaded length 41963 != reported length 41963

## Map from URL : http://tile.stamen.com/toner-lite/13/1313/3165.png

## Warning in download.file(url, destfile = tmp, quiet = !messaging, mode =
## "wb"): downloaded length 42004 != reported length 42004

## Map from URL : http://tile.stamen.com/toner-lite/13/1314/3165.png

## Warning: Using size for a discrete variable is not advised.

MAP 6:

ggmap(berkMap) +
  geom_point( data = mergedf, aes(x = long, y = lat, colour = factor(Race), size = factor(CarSearch) ), alpha = 0.5 ) + 
  scale_colour_discrete( "Race", labels = c("Asian", "Black", "Hispanic", "Other", "White")  ) +
  scale_size_discrete("CarSearch", labels = c("No Search", "Search"),
     range = c(1.75,6)) +
  theme ( 
        panel.grid.major = element_blank (), # remove major grid
        panel.grid.minor = element_blank (),  # remove minor grid
        axis.text = element_blank (), 
        axis.title = element_blank (),
        axis.ticks = element_blank ()
        ) + ggtitle("BPD Stops 2015-2016") +
  labs(size = "CarSearch")

## Warning: Using size for a discrete variable is not advised.

MAP ??:

# a contour plot
ggmap(berkMap) +
  stat_density2d(aes(x = long, y = lat, fill= ..level.., alpha = ..level..*2),
    size = 2, bins = 5, data = mergedf, geom = "polygon") +
  scale_fill_gradient(low = "black", high = "red")

MAP ?? 2

qmplot(long, lat, data = mergedf)

## Using zoom = 13...

qmplot(long, lat, data = mergedf, facets = ~ Race)

## Using zoom = 13...

MAP 7

# crime example by month
mergedf <- mergedf %>%
 # mutate( Call.Date.Time = mdy_hm( as.character(Call.Date.Time) ) ) %>%
 # mutate( Call.Hour = hour( as.character(Call.Date.Time) ) ) %>%
  #mutate( Call.Date = mdy( as.character(Call.Date.Time) ) ) %>%
  mutate( Call.Month = month( mdy_hm(Call.Date.Time) ) ) #%>%
 # mutate( Call.Weekday = wday( as.character(Call.Date.Time) ) )
mergedf$Call.Month <- factor(mergedf$Call.Month)

map7 <- get_map(location = "berkeley", zoom = 12, source = "osm", color = "bw")

## Map from URL : http://maps.googleapis.com/maps/api/staticmap?center=berkeley&zoom=12&size=640x640&scale=2&maptype=terrain&sensor=false

## Information from URL : http://maps.googleapis.com/maps/api/geocode/json?address=berkeley&sensor=false

BerkMap7 <- ggmap( map7,
  base_layer = ggplot(aes(x = long, y = lat), data = mergedf))

BerkMap7 +
  stat_density2d( aes(x = long, y = lat, fill = ..level.., alpha = ..level..),
    bins = I(5), geom = "polygon", data = mergedf ) +
  scale_fill_gradient2( "StopDensity",
    low = "white", mid = "orange", high = "red", midpoint = 500) +
  labs(x = "Longitude", y = "Latitude") + facet_wrap(~ Call.Month, ncol = 1) +
  scale_alpha(range = c(.2, .55), guide = FALSE) +
  ggtitle("BPD Stop Contour Map of Berkeley by Month") +
  guides(fill = guide_colorbar(barwidth = 1.5, barheight = 10))

MAP 8

{r} # # crime density by race: # mergedf <- mergedf %>% # # mutate( Call.Date.Time = mdy_hm( as.character(Call.Date.Time) ) ) %>% # # mutate( Call.Hour = hour( as.character(Call.Date.Time) ) ) %>% # #mutate( Call.Date = mdy( as.character(Call.Date.Time) ) ) %>% # mutate( Call.Month = month( mdy_hm(Call.Date.Time) ) ) #%>% # # mutate( Call.Weekday = wday( as.character(Call.Date.Time) ) ) # mergedf$Call.Month <- factor(mergedf$Call.Month) # # map7 <- get_map(location = "berkeley", zoom = 6, source = "osm", color = "bw") # BerkMap7 <- ggmap( map7, # base_layer = ggplot(aes(x = long, y = lat), data = mergedf)) # # BerkMap7 + # stat_density2d( aes(x = long, y = lat, fill = ..level.., alpha = ..level..), # bins = I(5), geom = "polygon", data = mergedf ) + # scale_fill_gradient2( "StopDensity", # low = "white", mid = "orange", high = "red", midpoint = 500) + # labs(x = "Longitude", y = "Latitude") + facet_wrap(~ Race ) + # scale_alpha(range = c(.2, .55), guide = FALSE) + # ggtitle("BPD Stop Contour Map of Berkeley by Race") + # guides(fill = guide_colorbar(barwidth = 1.5, barheight = 10)) #

MAP 9

ggmap(berkMap) +
  stat_density2d( aes(x = long, y = lat, fill = ..level.., alpha = ..level..),
    bins = I(5), geom = "polygon", data = mergedf ) +
  scale_fill_gradient2( "StopDensity",
    low = "white", mid = "orange", high = "red", midpoint = 100) +
  labs(x = "Longitude", y = "Latitude") + facet_wrap(~ Race , ncol = 1 ) +
  scale_alpha(range = c(.2, .55), guide = FALSE) +
  ggtitle("BPD Stop Contour Map of Berkeley by Race") +
  guides(fill = guide_colorbar(barwidth = 1.5, barheight = 10))

MAP 10 : AgeRange Density Facet

ggmap(berkMap) +
  stat_density2d( aes(x = long, y = lat, fill = ..level.., alpha = ..level..),
    bins = I(5), geom = "polygon", data = mergedf ) +
  scale_fill_gradient2( "Stop Density",
    low = "white", mid = "orange", high = "red", midpoint = 50) +
  labs(x = "Longitude", y = "Latitude") + facet_wrap(~ AgeRange, ncol = 1 ) +
  scale_alpha(range = c(.2, .55), guide = FALSE) +
  ggtitle("BPD Stop Contour Map of Berkeley by Age Range") +
  guides(fill = guide_colorbar(barwidth = 1.5, barheight = 10))

MAP 11: By Race Again

# ggmap(berkMap) +
# geom_point(aes(x = long, y = lat, colour = Race, size = Race),
#   data = mergedf)

ggmap(berkMap) +
stat_bin2d(
aes(x = long, y = lat, colour = Race, fill = Race),
size = .25, bins = 100, alpha = .25,
data = mergedf
)